home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 4: GNU Archives / Linux Cubed Series 4 - GNU Archives.iso / gnu / binutils.7 / binutils / binutils-2.7 / ld / testsuite / lib / ld.exp
Encoding:
Text File  |  1996-07-04  |  8.1 KB  |  338 lines
  1. #
  2. # default_ld_version 
  3. #    extract and print the version number of ld
  4. #
  5. proc default_ld_version { ld } {
  6.     global host_triplet
  7.  
  8.     if { [which $ld] == 0 } then {
  9.     perror "$ld does not exist"
  10.     exit 1
  11.     }
  12.     
  13.     catch "exec $ld --version" tmp
  14.     set tmp [prune_system_crud $host_triplet $tmp]
  15.     regexp "version.*$" $tmp version
  16.     
  17.     if [info exists version] then {
  18.     clone_output "$ld $version\n"
  19.     }
  20. }
  21.  
  22. #
  23. # default_ld_relocate 
  24. #    link an object using relocation
  25. #
  26. proc default_ld_relocate { ld target objects } {
  27.     global HOSTING_EMU
  28.     global host_triplet
  29.     
  30.     if { [which $ld] == 0 } then {
  31.     perror "$ld does not exist"
  32.     return 0
  33.     }
  34.     
  35.     send_log "$ld $HOSTING_EMU -o $target -r $objects\n"
  36.     verbose "$ld $HOSTING_EMU -o $target -r $objects"
  37.     
  38.     catch "exec $ld $HOSTING_EMU -o $target -r $objects" exec_output
  39.     set exec_output [prune_system_crud $host_triplet $exec_output]
  40.     if [string match "" $exec_output] then {
  41.     return 1
  42.     } else {
  43.     send_log "$exec_output\n"
  44.     verbose "$exec_output"
  45.     return 0
  46.     }
  47. }
  48.  
  49.  
  50. #
  51. # default_ld_link 
  52. #    link a program using ld
  53. #
  54. proc default_ld_link { ld target objects } {
  55.     global HOSTING_EMU
  56.     global HOSTING_CRT0
  57.     global HOSTING_LIBS
  58.     global host_triplet
  59.     
  60.     set objs "$HOSTING_CRT0 $objects"
  61.     set libs "$HOSTING_LIBS"
  62.     
  63.     if { [which $ld] == 0 } then {
  64.     perror "$ld does not exist"
  65.     return 0
  66.     }
  67.     
  68.     send_log "$ld $HOSTING_EMU -o $target $objs $libs\n"
  69.     verbose "$ld $HOSTING_EMU -o $target $objs $libs"
  70.     
  71.     catch "exec $ld $HOSTING_EMU -o $target $objs $libs" exec_output
  72.     set exec_output [prune_system_crud $host_triplet $exec_output]
  73.     if [string match "" $exec_output] then {
  74.     return 1
  75.     } else {
  76.     send_log "$exec_output\n"
  77.     verbose "$exec_output"
  78.     return 0
  79.     }
  80. }
  81.  
  82. #
  83. # default_ld_simple_link 
  84. #    link a program using ld, without including any libraries
  85. #
  86. proc default_ld_simple_link { ld target objects } {
  87.     global host_triplet
  88.     
  89.     if { [which $ld] == 0 } then {
  90.     perror "$ld does not exist"
  91.     return 0
  92.     }
  93.     
  94.     send_log "$ld -o $target $objects\n"
  95.     verbose "$ld -o $target $objects"
  96.     
  97.     catch "exec $ld -o $target $objects" exec_output
  98.     set exec_output [prune_system_crud $host_triplet $exec_output]
  99.  
  100.     # We don't care if we get a warning about a non-existent start
  101.     # symbol, since the default linker script might use ENTRY.
  102.     regsub -all "(^|\n)($ld: warning: cannot find entry symbol\[^\n\]*\n?)" $exec_output "\\1" exec_output
  103.  
  104.     if [string match "" $exec_output] then {
  105.     return 1
  106.     } else {
  107.     send_log "$exec_output\n"
  108.     verbose "$exec_output"
  109.     return 0
  110.     }
  111. }
  112.  
  113. #
  114. # default_ld_compile 
  115. #    compile an object using cc
  116. #
  117. proc default_ld_compile { cc source object } {
  118.     global CFLAGS
  119.     global srcdir
  120.     global subdir
  121.     global host_triplet
  122.  
  123.     set cc_prog $cc
  124.     if {[llength $cc_prog] > 1} then {
  125.     set cc_prog [lindex $cc_prog 0]
  126.     }
  127.     if {[which $cc_prog] == 0} then {
  128.     perror "$cc_prog does not exist"
  129.     return 0
  130.     }
  131.  
  132.     catch "exec rm -f $object" exec_output
  133.  
  134.     send_log "$cc -I$srcdir$subdir -c $CFLAGS $source -o $object\n"
  135.     verbose "$cc -I$srcdir$subdir -c $CFLAGS $source -o $object"
  136.  
  137.     catch "exec $cc -I$srcdir$subdir -c $CFLAGS $source -o $object" exec_output
  138.     set exec_output [prune_system_crud $host_triplet $exec_output]
  139.     if [string match "" $exec_output] then {
  140.     if {![file exists $object]} then {
  141.         regexp ".*/(\[^/\]*)$" $source all dobj
  142.         regsub "\\.c" $dobj ".o" realobj
  143.         verbose "looking for $realobj"
  144.         if {[file exists $realobj]} then {
  145.         send_log "mv $realobj $object\n"
  146.         verbose "mv $realobj $object"
  147.         catch "exec mv $realobj $object" exec_output
  148.         set exec_output [prune_system_crud $host_triplet $exec_output]
  149.         if {![string match "" $exec_output]} then {
  150.             send_log "$exec_output\n"
  151.             verbose "$exec_output"
  152.             perror "could not move $realobj to $object"
  153.             return 0
  154.         }
  155.         } else {
  156.         perror "$object not found after compilation"
  157.         return 0
  158.         }
  159.     }
  160.     return 1
  161.     } else {
  162.     send_log "$exec_output\n"
  163.     verbose "$exec_output"
  164.     perror "$source: compilation failed"
  165.     return 0
  166.     }
  167. }
  168.  
  169. #
  170. # default_ld_assemble
  171. #    assemble a file
  172. #
  173. proc default_ld_assemble { as source object } {
  174.     global ASFLAGS
  175.     global host_triplet
  176.     
  177.     if {[which $as] == 0} then {
  178.     perror "$as does not exist"
  179.     return 0
  180.     }
  181.  
  182.     if ![info exists ASFLAGS] { set ASFLAGS "" }
  183.  
  184.     send_log "$as $ASFLAGS -o $object $source\n"
  185.     verbose "$as $ASFLAGS -o $object $source"
  186.  
  187.     catch "exec $as $ASFLAGS -o $object $source" exec_output
  188.     set exec_output [prune_system_crud $host_triplet $exec_output]
  189.     if [string match "" $exec_output] then {
  190.     return 1
  191.     } else {
  192.     send_log "$exec_output\n"
  193.     verbose "$exec_output"
  194.     perror "$source: assembly failed"
  195.     return 0
  196.     }
  197. }
  198.  
  199. #
  200. # default_ld_nm
  201. #    run nm on a file, putting the result in the array nm_output
  202. #
  203. proc default_ld_nm { nm object } {
  204.     global NMFLAGS
  205.     global nm_output
  206.     global host_triplet
  207.  
  208.     if {[which $nm] == 0} then {
  209.     perror "$nm does not exist"
  210.     return 0
  211.     }
  212.  
  213.     if ![info exists NMFLAGS] { set NMFLAGS "" }
  214.  
  215.     send_log "$nm $NMFLAGS $object >tmpdir/nm.out\n"
  216.     verbose "$nm $NMFLAGS $object >tmpdir/nm.out"
  217.  
  218.     catch "exec $nm $NMFLAGS $object >tmpdir/nm.out" exec_output
  219.     set exec_output [prune_system_crud $host_triplet $exec_output]
  220.     if [string match "" $exec_output] then {
  221.     set file [open tmpdir/nm.out r]
  222.     while { [gets $file line] != -1 } {
  223.         verbose "$line" 2
  224.         if [regexp "^(\[0-9a-fA-F\]+) \[a-zA-Z0-9\] (.+)$" $line whole value name] {
  225.         verbose "Setting nm_output($name) to 0x$value" 2
  226.         set nm_output($name) 0x$value
  227.         }
  228.     }
  229.     close $file
  230.     return 1
  231.     } else {
  232.     send_log "$exec_output\n"
  233.     verbose $exec_output
  234.     perror "$object: nm failed"
  235.     return 0
  236.     }
  237. }
  238.  
  239. #
  240. # simple_diff
  241. #    compares two files line-by-line
  242. #    returns differences if exist
  243. #    returns null if file(s) cannot be opened
  244. #
  245. proc simple_diff { file_1 file_2 } {
  246.     global target
  247.     
  248.     set eof -1
  249.     set differences 0
  250.     
  251.     if [file exists $file_1] then {
  252.     set file_a [open $file_1 r]
  253.     } else {
  254.     warning "$file_1 doesn't exist"
  255.     return
  256.     }
  257.     
  258.     if [file exists $file_2] then {
  259.     set file_b [open $file_2 r]
  260.     } else {
  261.     fail "$file_2 doesn't exist"
  262.     return
  263.     }
  264.     
  265.     verbose "# Diff'ing: $file_1 $file_2\n" 2
  266.     
  267.     while { [gets $file_a line] != $eof } {
  268.     if [regexp "^#.*$" $line] then {
  269.         continue
  270.     } else {
  271.         lappend list_a $line
  272.     }
  273.     }
  274.     close $file_a
  275.     
  276.     while { [gets $file_b line] != $eof } {
  277.     if [regexp "^#.*$" $line] then {
  278.         continue
  279.     } else {
  280.         lappend list_b $line
  281.     }
  282.     }
  283.     close $file_b
  284.  
  285.     for { set i 0 } { $i < [llength $list_a] } { incr i } {
  286.     set line_a [lindex $list_a $i]
  287.     set line_b [lindex $list_b $i]
  288.  
  289.     verbose "\t$file_1: $i: $line_a\n" 3
  290.     verbose "\t$file_2: $i: $line_b\n" 3
  291.     if [string compare $line_a $line_b] then {
  292.         verbose "\t$file_1: $i: $line_a\n" 1
  293.         verbose "\t$file_2: $i: $line_b\n" 1
  294.  
  295.         send_log "\t$file_1: $i: $line_a\n"
  296.         send_log "\t$file_2: $i: $line_b\n"
  297.  
  298.         fail "Test: $target"
  299.         return
  300.     }
  301.     }
  302.     
  303.     if { [llength $list_a] != [llength $list_b] } {
  304.     fail "Test: $target"
  305.     return
  306.     }
  307.  
  308.     if $differences<1 then {
  309.     pass "Test: $target"
  310.     }
  311. }
  312.  
  313. # This definition is taken from an unreleased version of DejaGnu.  Once
  314. # that version gets released, and has been out in the world for a few
  315. # months at least, it may be safe to delete this copy.
  316. if ![string length [info proc prune_system_crud]] {
  317.     #
  318.     # prune_system_crud -- delete various system verbosities from TEXT on SYSTEM
  319.     #
  320.     # An example is:
  321.     # ld.so: warning: /usr/lib/libc.so.1.8.1 has older revision than expected 9
  322.     #
  323.     # SYSTEM is typical $target_triplet or $host_triplet.
  324.     #
  325.     # This is useful when trying to do pattern matches on program output.
  326.     # Sites with particular verbose os's may wish to override this in site.exp.
  327.     #
  328.     proc prune_system_crud { system text } {
  329.     # This is from sun4's.  Do it for all machines for now.
  330.     # The "\\1" is to try to preserve a "\n" but only if necessary.
  331.     regsub -all "(^|\n)(ld.so: warning:\[^\n\]*\n?)+" $text "\\1" text
  332.  
  333.     # It might be tempting to get carried away and delete blank lines, etc.
  334.     # Just delete *exactly* what we're ask to, and that's it.
  335.     return $text
  336.     }
  337. }
  338.